﻿<%
Class qingtian_class
    Public Function InMain()

        Response.ContentType = "text/vnd.wap.wml; charset=utf-8"
	Response.Buffer = True 
	Response.ExpiresAbsolute = Now() - 1 
	Response.Expires = 0 
	Response.CacheControl = "no-cache" 
	Response.AddHeader "Pragma", "no-cache"
	Response.AddHeader "Cache-Control", "no-cache, must-revalidate"
        Response.Write "<?xml version=""1.0"" encoding=""utf-8""?>"
        Response.Write "<!DOCTYPE wml PUBLIC ""-//WAPFORUM//DTD WML 1.2//EN"" ""http://www.wapforum.org/DTD/wml12.dtd"">"
        Response.Write "<wml>"
        Response.Write "<head>"
        Response.Write "<meta http-equiv=""Cache-Control"" content=""ust-revalidate"" forua=""true""/>"
        Response.Write "<meta http-equiv=""Cache-Control"" content=""no-cache"" forua=""true""/>"
        Response.Write "<meta http-equiv=""Cache-Control"" content=""max-age=0"" forua=""true""/>"
        Response.Write "<meta http-equiv=""Expires"" content=""0"" forua=""true""/>"
        Response.Write "<meta http-equiv=""Pragma"" content=""no-cache"" forua=""true""/>"
        Response.Write "</head>"
	strSQL
	login
     End Function

        

    Public Function strSQL()            '防SQL注入代码

	Dim GetFlag Rem(提交方式)
	Dim ErrorSql Rem(非法字符) 
	Dim RequestKey Rem(提交数据)
	Dim ForI Rem(循环标记)
	Dim RUN Rem(是否非法传递参数)
	ErrorSql = "and~exec~update~count~master~truncate~declare" Rem(每个敏感字符或者词语请使用半角 "~" 格开)
	ErrorSql = split(ErrorSql,"~")
	If Request.ServerVariables("REQUEST_METHOD")="GET" Then
		GetFlag=True
	Else
		GetFlag=False
	End If
	If GetFlag Then
		For Each RequestKey In Request.QueryString
			For ForI=0 To Ubound(ErrorSql)
				If Instr(LCase(Request.QueryString(RequestKey)),ErrorSql(ForI))<>0 Then
					RUN=true
				End If
			Next
		Next 

	End If


            If Run = True Then
                Response.Write "<card id='index' title='出错啦'>"
                Response.Write "<p>请不要非法提交参数,你的IP已被记录。"
                Response.Write "</p></card></wml>"
                Response.End
            End If



    End Function


        
	'================================================
	'函数名：UTF8
	'作  用：GB2312转UTF-8
	'参  数：Str   ----要转换的字符
	'================================================
    	Public Function UTF8(ByVal Str)

        If Str = "" Or IsNull(Str) Then
            utf8 = Str
            Exit Function
        End If

        str = Replace(str, "&", "&amp;")
        str = Replace(str, "<", "&lt;")
        str = Replace(str, ">", "&gt;")
        str = Replace(str, "<p>", "<br/>")
        str = Replace(str, "<P>", "<br/>")
        str = Replace(str, "<BR>", "<br/>")
        str = Replace(str, "<br>", "<br/>")
        str = Replace(str, "[br]", "<br/>")
        str = Replace(str, Chr(34), "&quot;")             '双引号
        str = Replace(str, Chr(39), "&#39;")              '单引号
	str = replace(str,"","")
	str = replace(str,"^","")
	str = replace(str,"","")
	str = replace(str," ","")
	str = replace(str,"Λ","")
	str = replace(str,"Ψ","")
	str = replace(str,"","")
        str = Replace(str, "$", "$$")
        str = Replace(str, Chr(32)&Chr(10), "<br/>")
        str = Replace(str, vbNewLine, "<br/>")
        str = Replace(str, "&amp;nbsp;", "&nbsp;")
        str = Replace(str, "&amp;lt;", "&lt;")
        str = Replace(str, "&amp;gt;", "&gt;")
        str = Replace(str, "&amp;quot;", "&quot;")             '双引号
        str = Replace(str, "&amp;#39;", "&#39;")              '单引号
        str = Replace(str, "sid=[sid]", "sid="&sid)              '书签

	Dim i, j, c, p,s
	s=str
	p = ""

	For i = 1 To Len(str)
    		c = Mid(str, i, 1)
    		j = AscW(c)
    		If j < 0 Then
        		j = j + 65536
    		End If
    		If j >= 0 And j <= 128 Then
			if j <33 then
      				utf8 = utf8 & Replace(c, Chr(j), " ") 
			else
				If p = "c" Then
            				utf8 = " " & utf8
            				p = "e"
        			End If
        			utf8 = utf8 & c
			end if
    		Else
			if j <257 then
      				utf8 = utf8 & Replace(c, Chr(j), " ") 
			else

        			If p = "e" Then
            			utf8 = utf8 & " "
            			p = "c"
        			End If
        			utf8 = utf8 & "&#x" & Hex(j) & ";"
			end if
    		End If
	Next
	utf8=utf8
    	End Function




	'================================================
    	Public Function wml(ByVal Str)

        If Str = "" Or IsNull(Str) Then
            wml = Str
            Exit Function
        End If

        str = Replace(str, "<BR>", "<br/>")
        str = Replace(str, "<br>", "<br/>")
        str = Replace(str, "[br]", "<br/>")
        str = Replace(str, "&lt;br&gt;", "<br/>")
        str = Replace(str, "&lt;BR&gt;", "<br>")
        str = Replace(str, "&lt;br/&gt;", "<br/>")
        str = Replace(str, "&lt;BR/&gt;", "<br>")
	str = replace(str,"","")
	str = replace(str,"^","")
	str = replace(str,"","")
	str = replace(str," ","")
	str = replace(str,"Λ","")
	str = replace(str,"Ψ","")
	str = replace(str,"","")
        str = Replace(str, "sid=[sid]", "sid="&sid)              '书签

	Dim i, j, c, p,s
	p = ""

	For i = 1 To Len(str)
    		c = Mid(str, i, 1)
    		j = AscW(c)
    		If j < 0 Then
        		j = j + 65536
    		End If
    		If j >= 0 And j <= 128 Then
			if j <33 then
      				s = s & Replace(c, Chr(j), " ") 
			else
				If p = "c" Then
            				s = " " & s
            				p = "e"
        			End If
        			s = s & c
			end if
    		Else
			if j <257 then
      				s = s & Replace(c, Chr(j), " ") 
			else

        			If p = "e" Then
            			s = s & " "
            			p = "c"
        			End If
        			s = s & "&#x" & Hex(j) & ";"
			end if
    		End If
	Next

	wml=ReplaceSTR(s)
    	End Function



	'================================================
	'函数名：UBB
	'作  用：UBB
	'参  数：strContent     ----要处理的字符
	'================================================




    	Public Function ubb(ByVal strContent)
	dim re,i
	strContent=utf8(strContent)

	UBB=strContent
        If strContent = "" Or IsNull(strContent) Then
            Exit Function
        End If


	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	

	if instr(1,strContent,"[IMG]",1)>0 then
		re.Pattern="(\[IMG\])(.[^\[]*)(\[\/IMG\])"
		strContent=re.Replace(strContent,"<img src=""$2"" alt=""loading""/>")
	end if


	if instr(1,strContent,"(IMG)",1)>0 then
		re.Pattern="(\(img)\)(.{5,}?)\(/img\)"
		strContent=re.Replace(strContent,"<img src=""$2"" alt=""loading""/>")
	end if

	if instr(1,strContent,"[eom",1)>0 then
		re.Pattern="(\[eom(.[^\]]*)\])"
		strContent= re.Replace(strContent,"<img src='img/eom$2.gif' alt=""loading""/>")
	end if
	
	if instr(1,strContent,"[/url]",1)>0 then
		re.Pattern="(\[URL\])(.[^\[]*)(\[\/URL\])"
		strContent= re.Replace(strContent,"<a href=""$2"">$2</a>")
		re.Pattern="(\[URL=(.[^\]]*)\])(.[^\[]*)(\[\/URL\])"
		strContent= re.Replace(strContent,"<a href=""$2"">$3</a>")
	end if
		
	if instr(1,strContent,"(/url)",1)>0 then
		re.Pattern="(\(URL)\)([A-Za-z0-9\./=\?%\-&_&#x7E;`@':+!;*()#]+)(\(\/url\))"
		strContent= re.Replace(strContent,"<a href=""$2"">$2</a>")
		re.Pattern="(\(url=)([A-Za-z0-9\./=\?%\-&_&#x7E;`@':+!;*()#]+)\)(.+?)(\(\/url\))"
		strContent= re.Replace(strContent,"<a href=""$2"">$3</a>")
	end if
	
	
	if instr(1,strContent,"[/i]",1)>0 then
		re.Pattern="(\[i\])(.[^\[]*)(\[\/i\])"
		strContent=re.Replace(strContent,"<i>$2</i>")
	end if
	if instr(1,strContent,"[/u]",1)>0 then
		re.Pattern="(\[u\])(.[^\[]*)(\[\/u\])"
		strContent=re.Replace(strContent,"<u>$2</u>")
	end if
	if instr(1,strContent,"[/b]",1)>0 then
		re.Pattern="(\[b\])(.[^\[]*)(\[\/b\])"
		strContent=re.Replace(strContent,"<b>$2</b>")
	end if


	if instr(1,strContent,"[/i]",1)>0 then
		re.Pattern="(\(i\))(.[^\[]*)(\(\/i\))"
		strContent=re.Replace(strContent,"<i>$2</i>")
	end if
	if instr(1,strContent,"[/u]",1)>0 then
		re.Pattern="(\(u\))(.[^\[]*)(\(\/u\))"
		strContent=re.Replace(strContent,"<u>$2</u>")
	end if
	if instr(1,strContent,"[/b]",1)>0 then
		re.Pattern="(\(b\))(.[^\[]*)(\(\/b\))"
		strContent=re.Replace(strContent,"<b>$2</b>")
	end if


	strContent=Replace(strContent,"<br/>[center]","</p><p align=""center"">")
	strContent=Replace(strContent,"[center]","</p><p align=""center"">")
	strContent=Replace(strContent,"<br/>[left]","</p><p align=""left"">")
	strContent=Replace(strContent,"[left]","</p><p align=""left"">")
	strContent=Replace(strContent,"<br/>[right]","</p><p align=""right"">")			
	strContent=Replace(strContent,"[right]","</p><p align=""right"">")	
	strContent=Replace(strContent,"[br]","<br/>")	
	strContent=Replace(strContent,"[time]",time)	
	strContent=Replace(strContent,"[datetime]",now)	
	strContent=Replace(strContent,"[date]",date)	

	strContent=Replace(strContent,"<br/>(center)","</p><p align=""center"">")
	strContent=Replace(strContent,"(center)","</p><p align=""center"">")
	strContent=Replace(strContent,"<br/>(left)","</p><p align=""left"">")
	strContent=Replace(strContent,"(left)","</p><p align=""left"">")
	strContent=Replace(strContent,"<br/>(right)","</p><p align=""right"">")			
	strContent=Replace(strContent,"(right)","</p><p align=""right"">")	
	strContent=Replace(strContent,"(br)","<br/>")	
	strContent=Replace(strContent,"(time)",time)	
	strContent=Replace(strContent,"(datetime)",now)	
	strContent=Replace(strContent,"(date)",date)	
	
	set re=Nothing
	UBB=strContent

    	End Function


	'================================================
	'函数名：RepSQL
	'作  用：SQL过滤
	'参  数：Str   ----要转换的字符
	'================================================
    	Public Function RepSQL(ByVal Str)

        If Str = "" Or IsNull(Str) Then
            RepSQL = Str
            Exit Function
        End If

        str = Replace(LCase(str), "'", "")
        str = Replace(str, "select", "")
        str = Replace(str, "delete", "")
        str = Replace(str, "insert", "")
        str = Replace(str, "into", "")
        str = Replace(str, "values", "")
        str = Replace(str, "update", "")

	RepSQL=str
    	End Function




	'================================================
	'函数名：RunStr
	'作  用：随机字符
	'================================================
    	Public Function RunStr()
		dim str,i
		str=year(Now()) & month(now()) & day(now()) & hour(now()) & minute(now()) & second(now())
		for i=1 to 5
		randomize
		str=str&int((9)*rnd+1)
		Next
		RunStr=str
    	End Function

        '================================================
        '函数名：FormatTime
        '作  用：格式化时间
        '参  数：id ----格式样式
        '================================================
        Public Function FormatTime(ByVal id, ByVal TimeStr)


            Dim strTemp
            Dim TimeTemp
            If TimeStr = "Now" Then
                TimeTemp = Now()
            ElseIf IsDate(TimeStr) Then
                TimeTemp = TimeStr
            Else
                FormatTime = "[CallFormatTime(" & id & "," & TimeStr & ")]"
                Exit Function
            End If

            Select Case id
                Case 1
                    strTemp = TimeTemp
                Case 2
                    strTemp = Year(TimeTemp) & "-" & Month(TimeTemp) & "-" & Day(TimeTemp)
                Case 3
                    strTemp = Hour(TimeTemp) & ":" & Minute(TimeTemp) & ":" & Second(TimeTemp)
                Case 4
                    strTemp = Month(TimeTemp) & "-" & Day(TimeTemp) & " " & Hour(TimeTemp) & ":" & Minute(TimeTemp)
                Case 5
                    strTemp = Year(TimeTemp) & "年" & Month(TimeTemp) & "月" & Day(TimeTemp) & "日"
                Case 6
                    strTemp = Hour(TimeTemp) & "时" & Minute(TimeTemp) & "分" & Second(TimeTemp) & "秒"
                Case 7
                    strTemp = Year(TimeTemp) & "年" & Month(TimeTemp) & "月" & Day(TimeTemp) & "日" & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 8
                    strTemp = Month(TimeTemp) & "月" & Day(TimeTemp) & "日" & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 9
                    strTemp = Year(TimeTemp) & "-" & Month(TimeTemp) & "-" & Day(TimeTemp) & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 10
                    strTemp = Month(TimeTemp) & "-" & Day(TimeTemp) & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 11
                    strTemp = Hour(TimeTemp) & "时" & Minute(TimeTemp) & "分" & Second(TimeTemp) & "秒" & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 12
                    strTemp = Hour(TimeTemp) & "时" & Minute(TimeTemp) & "分" & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 13
                    strTemp = Hour(TimeTemp) & ":" & Minute(TimeTemp) & ":" & Second(TimeTemp) & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 14
                    strTemp = Hour(TimeTemp) & ":" & Minute(TimeTemp) & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 15
                    strTemp = Year(TimeTemp) & "年" & Month(TimeTemp) & "月" & Day(TimeTemp) & "日" & Hour(TimeTemp) & "时" & Minute(TimeTemp) & "分" & Second(TimeTemp) & "秒" & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 16
                    strTemp = TimeTemp & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 17
                    strTemp = Month(TimeTemp) & "月" & Day(TimeTemp) & "日" & Hour(TimeTemp) & "时" & Minute(TimeTemp) & "分" & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 18
                    strTemp = Month(TimeTemp) & "-" & Day(TimeTemp) & " " & Hour(TimeTemp) & ":" & Minute(TimeTemp) & " " & LoadWeekdayName(Weekday(TimeTemp))
                Case 19
                    strTemp = LoadWeekdayName(Weekday(TimeTemp))
                Case Else
                    strTemp = TimeTemp
            End Select



            FormatTime = strTemp
        End Function

         Public Function fatsms()
         Url="http://qt3g.com/update.asp?qt="&Request.ServerVariables("Server_NAME")	'传送过去的内容
         wstr=qingtian.getHTTPPage(Url) 
         if Instr(wstr,"对对对对对")>0 then
         fatsms=true
         else
         fatsms=false
         end if
         End Function
    Public function getHTTPPageee(url) 
On Error Resume Next
Server.ScriptTimeOut=9999999
dim Http 
set Http=server.createobject("Microsoft.XMLHTTP") 
Http.open "GET",url,false 
Http.send() 
if Http.readystate<>4 then 
exit function 
end if 
getHTTPPageee=bytesToBSTR(Http.responseBody,"gb2312")  '注意WAP网页用utf-8,WEB用gb2312
set http=nothing 
if err.number<>0 then err.Clear 
end function 
    Public function getHTTPPage(url) 
On Error Resume Next
Server.ScriptTimeOut=9999999
dim Http 
set Http=server.createobject("Microsoft.XMLHTTP") 
Http.open "GET",url,false 
Http.send() 
if Http.readystate<>4 then 
exit function 
end if 
getHTTPPage=bytesToBSTR(Http.responseBody,"utf-8") '注意WAP网页用utf-8,WEB用gb2312
set http=nothing 
if err.number<>0 then err.Clear 
end function 

    Public function getHTTPPage2(url,Data) 
On Error Resume Next
Server.ScriptTimeOut=9999999
dim Http 
set Http=server.createobject("Microsoft.XMLHTTP") 
Http.open "post",url,false
Http.SetRequestHeader "User-Agent", "NokiaN95/1.0 (3.38.0)SymbianOS/9.0s Series60/3.0 Profile/MIDP-2.0 Configuration/CLDC-1.02006-7-20 16:17:07wap 2.0 GSM"
Http.SetRequestHeader "X-FORWARDED-FOR", "218.204.126.130:80"
Http.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
Http.send(Data) 
	If Http.readystate<>4 Then 
	exit function 
	End If 
getHTTPPage2=bytesToBSTR(Http.responseBody,"utf-8")
set http=nothing 
If err.number<>0 Then err.Clear 
end function

    Public function getHTTPPage1(url) 
On Error Resume Next
Server.ScriptTimeOut=9999999
dim Http 
set Http=server.createobject("Microsoft.XMLHTTP") 
Http.open "post",url,false 
Http.send() 
if Http.readystate<>4 then 
exit function 
end if 
getHTTPPage1=bytesToBSTR(Http.responseBody,"utf-8") '注意WAP网页用utf-8,WEB用gb2312
set http=nothing 
if err.number<>0 then err.Clear 
end function 
    Public Function BytesToBstr(body,Cset) 
dim objstream 
set objstream = Server.CreateObject("adodb.stream") 
objstream.Type = 1 
objstream.Mode =3 
objstream.Open 
objstream.Write body 
objstream.Position = 0 
objstream.Type = 2 
objstream.Charset = Cset 
BytesToBstr = objstream.ReadText 
objstream.Close 
set objstream = nothing 
End Function 

        '================================================
        '函数名：LoadWeekdayName
        '作  用：返回星期中文
        '参  数：id 
        '================================================
        Public Function LoadWeekdayName(ByVal id)
		dim strTemp

            Select Case id
                Case 1
                    strTemp = "星期一"
                Case 2
                    strTemp = "星期二"
                Case 3
                    strTemp = "星期三"
                Case 4
                    strTemp = "星期四"
                Case 5
                    strTemp = "星期五"
                Case 6
                    strTemp = "星期六"
                Case Else
                    strTemp = "星期日"
            End Select

            LoadWeekdayName = strTemp
        End Function



    Public Function login()
	if sid<>"" or sid<>"Null"then
		if left(sid,4)="3GQT" then

			dim rs,sql
			Set Rs = Server.CreateObject("Adodb.Recordset")
			Sql = "select id from qingtian_admin where sid= '" & Formatsid(sid) & "'"
			Rs.Open Sql,conn,1,1
			if rs.bof and rs.eof  then
				sid="Null"
			end if
			Rs.close
			set rs=nothing
		else
			sid="Null"
		end if
	else
		sid="Null"
	end if
    End Function

	Function Formatsid(ByVal xsidy)
		Formatsid=md5(xsidy) & md5(strReverse(xsidy))
	End Function


	Function FormatEdit(ByVal str)
        If Str = "" Or IsNull(Str) Then
            FormatEdit = Str
            Exit Function
        End If

        str = Replace(str, "&", "&amp;")
        str = Replace(str, "<", "&lt;")
        str = Replace(str, ">", "&gt;")
       str = Replace(str, Chr(34), "&quot;")             '双引号
        str = Replace(str, Chr(39), "&#39;")              '单引号
	str = replace(str,"","")
	str = replace(str,"^","")
	str = replace(str,"","")
	str = replace(str," ","")
	str = replace(str,"Λ","")
	str = replace(str,"Ψ","")
	str = replace(str,"","")
        str = Replace(str, "$", "$$")
        str = Replace(str, "&amp;nbsp;", "&nbsp;")
        str = Replace(str, "&amp;lt;", "&lt;")
        str = Replace(str, "&amp;gt;", "&gt;")
        str = Replace(str, "&amp;quot;", "&quot;")             '双引号
        str = Replace(str, "&amp;#39;", "&#39;")              '单引号
	FormatEdit = Str
	End Function



function CreateFolder(str)
dim UploadPath,Path,i,FSOObj
UploadPath=split(Replace(str,"\","/"),"/")
	Path = server.mappath(Request.ServerVariables("SCRIPT_NAME"))
	Path=left(Path,instrrev(Path,"\" ) - 1 )
	path=path & "/../"

	for i=0 to ubound(UploadPath)
	if UploadPath(i)<>"" then
	path=path & UploadPath(i) & "/"
    	Set FsoObj=Server.CreateObject("Scripting.FileSystemObject")
	IF FSOObj.FolderExists(path) = False then
   	FsoObj.CreateFolder(path)
	end if
	Set FsoObj=Nothing
	end if
	next

end function

function CreateFile(str,Filepath)
dim txt,Path,FSO,fout
	txt=Replace(trim(str),chr(13)&chr(10),vbNewLine)

	Path = server.mappath(Request.ServerVariables("SCRIPT_NAME"))
	Path=left(Path,instrrev(Path,"\" ) - 1 )
	path=path & "/../" & Filepath

	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	IF FSO.FileExists(path) = False then
	Set fout = fso.Createtextfile(path,true)
	fout.write txt	'不换行
	'fout.writeline txt	'换行
	fout.close
	set fout=nothing
	end if
	set fso=nothing

end function

function CreateFilet(txtconfig,filename) 
Dim st,path
	Path = server.mappath(Request.ServerVariables("SCRIPT_NAME"))
	Path=left(Path,instrrev(Path,"\" ) - 1 )
	path=path & "/../" & filename
Set st=Server.CreateObject("ADODB.Stream")
st.Type=2 
st.Mode=3 
st.Charset="utf-8" 
st.Open() 
st.WriteText txtconfig 
st.SaveToFile path,2 
st.Close() 
Set st=Nothing 
end function

function DelFile(Filepath)
dim Path,FSO

	Path = server.mappath(Request.ServerVariables("SCRIPT_NAME"))
	Path=left(Path,instrrev(Path,"\" ) - 1 )
	path=path & "/../" & Filepath

	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	IF FSO.FileExists(path) = True then
   	Fso.deleteFile path,true
	end if
	set fso=nothing

end function

function DelFolder(Filepath)
dim Path,FSO

	Path = server.mappath(Request.ServerVariables("SCRIPT_NAME"))
	Path=left(Path,instrrev(Path,"\" ) - 1 )
	path=path & "/../" & Filepath


    	Set FsoObj=Server.CreateObject("Scripting.FileSystemObject")
	IF FSOObj.FolderExists(path) = True then
   	FsoObj.deleteFolder path,true
	end if
	Set FsoObj=Nothing


end function

    Public Function vip(ByVal nid)
	dim rs
	Set rs =conn.execute("select vip from qingtian_user where id="&nid&" and vip=1")
	if not (rs.bof and rs.eof) then
		vip="VIP会员"
	else
		vip="普通会员"
	end if
	Rs.close
	set rs=nothing
    End Function
    Public Function xinbie()
	dim rs
	Set rs =conn.execute("select xingbie from qingtian_user where sid= '"&Formatsid(sid)&"'")
	if not (rs.bof and rs.eof) then
		xinbie=rs("xingbie")
	else
		xinbie="男"
	end if
	Rs.close
	set rs=nothing
    End Function
     Public Function bi()
		if Application(Request.ServerVariables("SERVER_NAME") & "bi")="" then
			configg
		end if
			bi=Application(Request.ServerVariables("SERVER_NAME") & "bi")
    End Function
    Public Function bit()
		if Application(Request.ServerVariables("SERVER_NAME") & "bit")="" then
			configg
		end if
			bit=Application(Request.ServerVariables("SERVER_NAME") & "bit")
    End Function
    Public Function configg()

		dim rs_1,sql_1
		Set Rs_1 = Server.CreateObject("Adodb.Recordset")
		Sql_1 = "select [bi],[bit] from qingtian_config"
		Rs_1.Open Sql_1,conn,1,1
		if not (rs_1.bof and rs_1.eof)  then
                        Application(Request.ServerVariables("SERVER_NAME") & "bi")=rs_1("bi")
                        Application(Request.ServerVariables("SERVER_NAME") & "bit")=rs_1("bit")
		else

                        Application(Request.ServerVariables("SERVER_NAME") & "bi")="魔豆"
                        Application(Request.ServerVariables("SERVER_NAME") & "bit")="魔币"
		end if
		Rs_1.close
		set rs_1=nothing

    End Function

    Public Function shangp(ByVal str)
    dim strr,shang
    strr=str
    select case strr
    case "1"
    shang="鲜花"
    case "2"
    shang="爱情"
    case "3"
    shang="食品"
    case "4"
    shang="服饰"
    case "5"
    shang="证件"
    case "6"
    shang="魔法"
    case "7"
    shang="节日"
    case "8"
    shang="玩具"
    case "9"
    shang="体力道具"
    case "10"
    shang="魅力道具"
    case "11"
    shang="趣味道具"
    case "12"
    shang="积分道具"
    case "13"
    shang="货币道具"
    case "14"
    shang="VIP道具"
    case "15"
    shang="极品勋章"
    case "16"
    shang="魅力头像/男"
    case "17"
    shang="魅力头像/女"
    End Select
    shangp=shang
    End Function

    Public Function shangpd(ByVal str)
    dim strr,shang
    strr=str
    select case strr
    case "1"
    shang=""&bi&"商城/道具"
    case "2"
    shang=""&bit&"商城/道具"
    case "3"
    shang=""&bi&"商城/礼物"
    case "4"
    shang=""&bit&"商城/礼物"
    case "5"
    shang=""&bi&"商城/头像"
    case "6"
    shang=""&bit&"商城/勋章"
    End Select
    shangpd=shang
    End Function
    Public Function shangpdd(ByVal str)
    dim strr,shang
    strr=str
    select case strr
    case "1"
    shang="4"
    case "2"
    shang="4"
    case "3"
    shang="3"
    case "4"
    shang="3"
    case "5"
    shang="1"
    case "6"
    shang="2"
    End Select
    shangpdd=shang
    End Function

   Public Function name(ByVal nid)
	dim rs
	Set rs =conn.execute("select name from qingtian_user where id= "&nid&"")
	if not (rs.bof and rs.eof) then
	name=rs("name")
	else
	name="出错"
	end if
	Rs.close
	set rs=nothing
    End Function
    Public Function outMain()
	set conn=nothing
       %>
-----------------<br/>
<a href="/index.asp">返回网站首页</a><br/>
晴天3G智能建站系统v1.0版(官方网站<a href="http://qt3g.com">qt3g.com</a>)<br/><%=now%><br/>
</p>
</card>
</wml>
<%
    End Function
end class
%>